home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1996 June / EnigmA AMIGA RUN 08 (1996)(G.R. Edizioni)(IT)[!][issue 1996-06][EARSAN CD VII].iso / earcd / amos / jwindows.lha / Paint.asc < prev    next >
Text File  |  1996-04-25  |  15KB  |  438 lines
  1. 'Note: 
  2. '   You may have trouble running this program from the editor. If so,
  3. 'change the Path$ variable in INITIALISE to point to the directory this
  4. 'example is in. This isn't a problem when compiled.
  5.  
  6. '********************************************************************
  7. '* 
  8. '*   Painter 
  9. '* 
  10. '********************************************************************
  11.  
  12. '   This is a very simple paint program, an extension of the scribble  
  13. 'example. It is, admittedly rather hampered by the lack of a fill command, 
  14. 'but what the hell...
  15.  
  16. '   Here we demonstrate a rather larger program than has been used before, 
  17. 'involving two windows (two WHOLE windows??!), a painting area and a palette.
  18. 'It shows the use of super windows, gimme zero zero windows, and the custom
  19. 'scroller routines provided in the Scroller.amos example. We open a super
  20. 'window with an actual area the size and depth of the workbench screen,
  21. 'and then scroll around this using J Scroll Super Window. Other stuff has
  22. 'all been seen before, such as basic gadgets, menus and drawing commands.
  23. 'There are alot of extra IDCMP messages used here, such as INTUITICKS for
  24. 'the spray can, and the WA_MouseQueue tag for the window.
  25.  
  26. '   Some changes have been made to the GadToolsBox source: 
  27.  
  28. '   The variable SD has been added to hold the default screen depth. The 
  29. 'palette gadget will be drawn with this number of planes. The art window 
  30. 'has been changed into a super window, the size and depth of the default 
  31. 'screen. The J Close Window line in _FREE_WINDOW has been changed to 
  32. 'J Close Super Window. This is safe to call on non-super windows.
  33. '   Other minor changes have been made for stuff I forget to add in the
  34. 'GadToolsBox program (bad planning). 
  35.  
  36. '   The scroller routines added are explained in the Scroller.amos program,
  37. 'the advantage being that they automatically resize and move when the window 
  38. 'changes. They are handled as follows: 
  39. '   The size of each scroller is the size of the drawing area the window 
  40. 'contains. The visible area (the size of the widget on the scroller) is the
  41. 'actual size of the window.
  42. '   We then track the offset of the drawing area from the top left of the
  43. 'window using the variables _SBX,_SBY. Sliding the bottom scroller distance
  44. 'x to the right will put the top left of the drawing area distance -x from the top 
  45. 'top left of the window, and _SBX is set to the value x. 
  46. '   When the window is resized, we must change the size of the widget in the 
  47. 'scroller to reflect the new area we are representing. We may also need to 
  48. 'move the drawing area. This will occur when the user is looking at the bottom 
  49. 'right of the drawing area, then enlarges the window. The drawing area must
  50. 'be moved right and down to prevent the window showing a region off the edge 
  51. 'of the drawing area.
  52.  
  53. '   A technique of use to other art program writers shown here is rubber 
  54. 'banding. An interesting feature of Gr Writing 2 is that if you draw a shape,
  55. 'then draw exactly over it again, the image is restored exactly as it was. 
  56. 'This allows us to rubber band shapes like lines or bars so the user can 
  57. 'experiment with where the shape should go before placing it. The shape is 
  58. 'then drawn with Gr Writing 0. 
  59.  
  60. Global _SCRAPTAGS,SCRAPTAGS,_PORTLIST,_MESSLIST
  61. Global PATH$,OSVER
  62. '** SD was put here with the rest of the prefs 
  63. Global FHEIGHT,FWIDTH,MBAR,OX,OY,SW,SH,SD
  64. Dim _ARTGADS(0)
  65. Global _ARTGADS()
  66. Global _ARTMENU,_ARTMENADD
  67. Global _ARTWIND
  68. Dim _PALETTEGADS(1)
  69. Global _PALETTEGADS()
  70. Global _PALETTE
  71. Dim _PALETTEZOOM(1)
  72. Global _PALETTEZOOM()
  73. Global _PALETTEWIND
  74.  
  75. On Error Proc _CLEANUP
  76.  
  77. '** _SCRLLERS is used to represent the border scroller gadgets.
  78. '   _SBX, _SBY are the offset of the top left of the window from the top 
  79. '   left of the drawing area.
  80. Global _SCRLLERS
  81. Global _SBX,_SBY
  82.  
  83. '** _DRAW is 1 when the LMB is pressed, 0 when it isn't. 
  84. '   _TYPE is the drawing mode 0-6, in the same order the tools are on the
  85. '   tools menu. Defaults to free hand (1)
  86. '   _OX, _OY hold the origin of a drawing operation (a line, or whatever)
  87. '   _LX, _LY hold the position we last drew to so we can draw over it again
  88. '   for rubber banding purposes. 
  89. Global _DRAW,_TYPE,_OX,_OY,_LX,_LY
  90. _TYPE=1
  91.  
  92. _INITIALIZE
  93. _GUIDATA
  94. _SETUPALL
  95. _SETPORTS
  96.  
  97. 'Make sure we draw to the right window 
  98. J This Window _ARTWIND
  99. Do 
  100.    K=J Wait Message
  101.    While K
  102.       C=J Tag Data(_MESSLIST,1)
  103.  
  104.       If C=Equ("IDCMP_CLOSEWINDOW")
  105.          'Bring up a requester before quiting 
  106.          If J Easy Request(_ARTWIND,"Quit"," Are you ure you"+Chr$(10)+"want to quit?"," Quit | Cancel ",0)
  107.             _CLEANUP
  108.          End If 
  109.  
  110.       Else If C=Equ("IDCMP_REFRESHWINDOW")
  111.          _DOREFRESH
  112.  
  113.       Else If J Tag Data(_MESSLIST,9)=_ARTWIND
  114.          'There is a lot of handling, so I've stuck it in another procedure.
  115.          _HANDLE_ARTWIND[C]
  116.  
  117.       Else If J Tag Data(_MESSLIST,9)=_PALETTEWIND
  118.          'The only interesting event from the palette window is the user  
  119.          'picking a colour, so watch for this 
  120.          If C=Equ("IDCMP_GADGETUP")
  121.             J This Window _ARTWIND
  122.             J Ink J Tag Data(_MESSLIST,2)
  123.          End If 
  124.  
  125.       End If 
  126.       K=J Next Message
  127.    Wend 
  128. Loop 
  129.  
  130. 'This is the biggy...
  131. Procedure _HANDLE_ARTWIND[C]
  132.    On Error Proc _CLEANUP
  133.  
  134.    If C=Equ("IDCMP_IDCMPUPDATE")
  135.       'First off, deal with the scrollers being moved. We get the position 
  136.       'of each (just to make sure we didn't miss anything), as X and Y.
  137.       'We then check they aren't both in the same place (don't move if you 
  138.       'don't need to...) 
  139.       'Finally, we move the scroll the window, and change _SBX and _SBY    
  140.       _GETSCROLLERPOS[_SCRLLERS,True]
  141.       X=Param
  142.       _GETSCROLLERPOS[_SCRLLERS,False]
  143.       Y=Param
  144.       If X<>_SBX or Y<>_SBY
  145.          J Scroll Super Window _ARTWIND,X-_SBX,Y-_SBY
  146.          _SBX=X : _SBY=Y
  147.       End If 
  148.  
  149.    Else If C=Equ("IDCMP_NEWSIZE")
  150.       'Here we deal with the user resizing the window. 
  151.       'First get the window's new size (inner size, that is) 
  152.       IW=J Window Width-J X Offset-J Border Right-1
  153.       IH=J Window Height-J Y Offset-J Border Bottom-1
  154.  
  155.       'Now we check if further scrolling is required to keep only the
  156.       'drawing area visible. I'm not even going to attempt explaining the
  157.       'twisted logic in these formulas - I can't remember, and I only wrote
  158.       'them half an hour ago...
  159.       DX=0 : DY=0
  160.       If IW>-_SBX+SW
  161.          DX=IW+_SBX-SW
  162.       End If 
  163.       If IH>-_SBY+SH
  164.          DY=IH+_SBY-SH
  165.       End If 
  166.       J Scroll Super Window _ARTWIND,-DX,-DY
  167.       _SBX=_SBX-DX : _SBY=_SBY-DY
  168.  
  169.       'Finally, we adjust the size of the widget in the scrollers
  170.       J Tag SCRAPTAGS,1,Equ("PGA_Visible"),IW
  171.       J Tag 0,0
  172.       _SETSCROLLERDATA[_ARTWIND,_SCRLLERS,True,SCRAPTAGS]
  173.       J Tag SCRAPTAGS,1,Equ("PGA_Visible"),IH
  174.       _SETSCROLLERDATA[_ARTWIND,_SCRLLERS,False,SCRAPTAGS]
  175.  
  176.    Else If C=Equ("IDCMP_MOUSEBUTTONS")
  177.  
  178.       If J Tag Data(_MESSLIST,2)=Equ("SELECTDOWN")
  179.          'If the user pressed the LMB:
  180.          'Put us in drawing mode, and make the origin (_OX,_OY) this position 
  181.          'We also move the graphics cursor to here and set the last position
  182.          'to here. Various of these are necessary for various drawing 
  183.          'operations. 
  184.          'We also change the drawing mode if this operation requires rubber 
  185.          'banding.
  186.          _DRAW=1
  187.          _OX=J Tag Data(_MESSLIST,5)-J X Offset+_SBX
  188.          _OY=J Tag Data(_MESSLIST,6)-J Y Offset+_SBY
  189.          _LX=_OX : _LY=_OY
  190.          Gr Locate _OX,_OY
  191.          If _TYPE>1 and _TYPE<6
  192.             Gr Writing 2
  193.          Else 
  194.             Gr Writing 0
  195.          End If 
  196.  
  197.       Else If J Tag Data(_MESSLIST,2)=Equ("SELECTUP")
  198.          'If the user released the LMB: 
  199.          'Take us out of drawing mode.
  200.          'Fill in the shape. If there was rubber banding, we actually draw
  201.          'it twice, but this is a very minor bug. 
  202.          _DRAW=0
  203.          _LX=J Tag Data(_MESSLIST,5)-J X Offset+_SBX
  204.          _LY=J Tag Data(_MESSLIST,6)-J Y Offset+_SBY
  205.          Gr Writing 0
  206.          _DRAW[_LX,_LY]
  207.       End If 
  208.  
  209.    Else If C=Equ("IDCMP_MOUSEMOVE") and _DRAW
  210.       'If the user has moved the mouse in drawing mode, we do the drawing
  211.       'operation.
  212.       _DRAW[J Tag Data(_MESSLIST,5)-J X Offset+_SBX,J Tag Data(_MESSLIST,6)-J Y Offset+_SBY]
  213.  
  214.    Else If C=Equ("IDCMP_INTUITICKS") and _DRAW and _TYPE=6
  215.       'INTUITICKS sends about 5-10 messages a second, which we need for
  216.       'the spray can so the user can hold it in one place and spray. 
  217.       _DRAW[J Tag Data(_MESSLIST,5)-J X Offset+_SBX,J Tag Data(_MESSLIST,6)-J Y Offset+_SBY]
  218.  
  219.    Else If C=Equ("IDCMP_MENUPICK")
  220.       'Finally, the menus. Read them off in the normal way...
  221.       C=J Tag Data(_MESSLIST,2)
  222.       M=J Read Menu(C)
  223.       I=J Read Item(C)
  224.  
  225.       If M=0
  226.          If I=0
  227.             'If New Project was selected, request then do it.
  228.             If J Easy Request(_ARTWIND,"Clear Screen","Sure you want to"+Chr$(10)+"clear the screen?"+Chr$(10)+"No undo is possible!"," Clear | Cancel ",0)
  229.                J This Window _ARTWIND
  230.                J Cls 0
  231.             End If 
  232.          Else If I=2
  233.             'Quit, as usual, calls up a requester before doing it. 
  234.             If J Easy Request(_ARTWIND,"Quit"," Are you ure you"+Chr$(10)+"want to quit?"," Quit | Cancel ",0)
  235.                _CLEANUP
  236.             End If 
  237.          End If 
  238.  
  239.       Else If M=1
  240.          'Change the type of tool we're using at the moment.
  241.          _TYPE=I
  242.       End If 
  243.  
  244.    End If 
  245.    
  246. End Proc
  247. 'another biggy...
  248. Procedure _DRAW[X,Y]
  249.    On Error Proc _CLEANUP
  250.    
  251.    'X,Y are the current mouse coordinates.
  252.  
  253.    If _TYPE=0
  254.       'Dots: just put a point under the mouse
  255.       Plot X,Y
  256.  
  257.    Else If _TYPE=1
  258.       'Free hand: Draw a line from where we last were to where we are now. 
  259.       Draw To X,Y
  260.  
  261.    Else If _TYPE=2
  262.       'Lines: First, draw to the last position. Because we're rubber banding,
  263.       'this will erase the last line. Then draw a new line.
  264.       Draw _OX,_OY To _LX,_LY
  265.       Draw _OX,_OY To X,Y
  266.       _LX=X : _LY=Y
  267.  
  268.    Else If _TYPE=3
  269.       'Boxes: Just like Lines. 
  270.       Box _OX,_OY To _LX,_LY
  271.       Box _OX,_OY To X,Y
  272.       _LX=X : _LY=Y
  273.  
  274.    Else If _TYPE=4
  275.       'Ellipses: First, calculate x and y radii for the ellipse, then if 
  276.       'these are both greater than 1, draw the ellipse. This is done twice 
  277.       'for rubber banding. 
  278.       RX=Abs(_OX-_LX) : RY=Abs(_OY-_LY)
  279.       If RX=>1 and RY=>1
  280.          Ellipse _OX,_OY,RX,RY
  281.       End If 
  282.       RX=Abs(_OX-X) : RY=Abs(_OY-Y)
  283.       If RX=>1 and RY=>1
  284.          Ellipse _OX,_OY,RX,RY
  285.       End If 
  286.       _LX=X : _LY=Y
  287.  
  288.    Else If _TYPE=5
  289.       'Bars: Should be like boxes, but AMOS's bar command is over-sensitive. 
  290.       'If the coordinates are the wrong way round, we must swap them, other
  291.       'wise an error is generated. This requiers two temporary variables.
  292.       'Also, the box must be at least 1x1 in size, so check that.
  293.       TX=_OX : TY=_OY
  294.       If TX>_LX : Swap TX,_LX : End If 
  295.       If TY>_LY : Swap TY,_LY : End If 
  296.       If _LX>TX and _LY>TY
  297.          Bar TX,TY To _LX,_LY
  298.       End If 
  299.       _LX=X : _LY=Y
  300.       TX=_OX : TY=_OY
  301.       If TX>X : Swap TX,X : End If 
  302.       If TY>Y : Swap TY,Y : End If 
  303.       If X>TX and Y>TY
  304.          Bar TX,TY To X,Y
  305.       End If 
  306.  
  307.    Else If _TYPE=6
  308.       'Spray Can: This splatters pointers in a circle, radius 10. First
  309.       'we take a random point within 10 pixels of the cursor, then check 
  310.       'this is within a circle radius 10 (otherwise, we get a square). 
  311.       'The formula is x^2 + y^2 <= radius^2, which defines a circle
  312.       For I=0 To 4
  313.          DX=Rnd(20)-10 : DY=Rnd(20)-10
  314.          If DX^2+DY^2<=100
  315.             Plot X+DX,Y+DY
  316.          End If 
  317.       Next I
  318.    End If 
  319.  
  320. End Proc
  321.  
  322. Procedure _INITIALIZE
  323. '** Added the SD=J Screen Depth line 
  324. Procedure _SETUPALL
  325. Procedure _GUIDATA
  326. Procedure _MAKEARTGADS
  327. '** Changed to a super window, and added scrollers 
  328. Procedure _MAKEARTWIND[SC]
  329. '** changed so depth of palette gadget = SD
  330. Procedure _MAKEPALETTEGADS
  331. Procedure _MAKEPALETTEWIND[SC]
  332. Procedure _DOREFRESH
  333. Procedure _SETPORTS
  334. '** chaged J Close Window to J Close Super Window
  335. Procedure _FREEWIND[W,G,M,A,C]
  336. '** added line to free scrollers 
  337. Procedure _CLEANUP
  338.  
  339. '************************************************************************
  340.  
  341. '   scrollers = _CREATESCROLLERS[ window, right total, right visible,
  342. '      botom total, bottom visible]
  343.  
  344. '   When you get an IDCMP message from one of the scrollers, it will be of 
  345. 'class IDCMP_IDCMPUPDATE, and the code field will contain 0 if it is the 
  346. 'right slider or 1 if it's the bottom one. You can then get the slider height
  347. 'using _GETSCROLLERPOS.  
  348.  
  349. Procedure _CREATESCROLLERS[W,RT,RV,BT,BV]
  350.  
  351. '************************************************************************
  352.  
  353. '   _FREESCROLLERS[ scrollers ]
  354.  
  355. Procedure _FREESCROLLERS[G]
  356.    On Error Goto E
  357.    
  358.    'quit if there is no gadget list 
  359.    If G=False Then Goto E
  360.    
  361.    'get the address of the map from the first gadget and free it. 
  362.    T=Leek(G+Equ("gg_UserData"))
  363.    If T Then T=J Free Mem(T,12)
  364.    
  365.    'get the address of the bottom gadget
  366.    N=Leek(G+Equ("gg_NextGadget"))
  367.    'free the right gadget 
  368.    Areg(0)=G
  369.    V=Intcall(Lvo("DisposeObject"))
  370.    'free the bottom gadget (if it was successfully created).
  371.    If N
  372.       Areg(0)=N
  373.       V=Intcall(Lvo("DisposeObject"))
  374.    End If 
  375.    
  376.    E:
  377. End Proc
  378.  
  379. '************************************************************************
  380.  
  381. '   position = _GETSCROLLERPOS[ scrollers, which? ]
  382.  
  383. Procedure _GETSCROLLERPOS[G,X]
  384.    If G=0 Then Goto E
  385.    
  386.    'the attribute we want 
  387.    Dreg(0)=Equ("PGA_Top")
  388.    'the gadget we want
  389.    If X
  390.       G=Leek(G)
  391.    End If 
  392.    Areg(0)=G
  393.    'the result is stored here 
  394.    R=0
  395.    Areg(1)=Varptr(R)
  396.    'call the function 
  397.    V=Intcall(Lvo("GetAttr"))
  398.    
  399.    E:
  400. End Proc[R]
  401.  
  402. '************************************************************************
  403.  
  404. '   _SETSCROLLERDATA[ window, scrollers, which?, taglist ] 
  405.  
  406. '   Very similar to J Set Gadget Data, this command allows you to change 
  407. 'the total area, visible area and slider position of a scroller. The tags
  408. 'to use are PGA_Total, PGA_Visible and PGA_Top, and provide a taglist just 
  409. 'as for J Set Gadget Data. 
  410.  
  411. Procedure _SETSCROLLERDATA[W,G,X,T]
  412.  
  413. '************************************************************************
  414.  
  415. '   _ADDSCROLLERS[ window, scrollers ] 
  416.  
  417. Procedure _ADDSCROLLERS[W,G]
  418.    On Error Goto E
  419.    
  420.    If G=0 or W=0 Then Goto E
  421.    
  422.    Areg(0)=W
  423.    Areg(1)=G
  424.    Dreg(0)=-1
  425.    Dreg(1)=-1
  426.    Areg(2)=False
  427.    V=Intcall(Lvo("AddGList"))
  428.    Areg(0)=G
  429.    Areg(1)=W
  430.    Areg(2)=False
  431.    Dreg(0)=-1
  432.    V=Intcall(Lvo("RefreshGList"))
  433.    
  434.    E:
  435. End Proc
  436.  
  437.  
  438.